home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / UTILITY / DEQUEUE.lisp < prev    next >
Encoding:
Text File  |  1990-06-25  |  6.0 KB  |  130 lines  |  [TEXT/CCL ]
  1. ; (c) Copyright 1990 by University of Massachusetts. All rights reserved.
  2. ; This software was conceived, designed, and written by Dan Suthers 
  3. ; while supported by the National Science Foundation under grant number
  4. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  5. ; CA.  Partial support was also received from the Office of Naval Research
  6. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  7. ; Mr. Suthers created this software under his own initiative while in an 
  8. ; academic relationship with the University of Massachusetts.  The above
  9. ; copyright notice was a condition placed by University lawyers on approval
  10. ; of distribution of this software by Apple Computer, and is not meant to
  11. ; imply that this software was created in an employment or "work for hire"
  12. ; relationship between the University and Mr. Suthers.
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; File:         Dequeue.lisp
  15. ; Author:       Dan Suthers
  16. ; Created:      25-Jan-90 22:45:33
  17. ; Modified:     22-Jun-90 01:57:19 (Dan Suthers)
  18. ; Language:     Common Lisp
  19. ; Package:      USER
  20. ;
  21. ; Description:  Double Ended Queue macros.
  22. ;
  23. ; (c) Copyright 1990, by Daniel D. Suthers
  24. ;                        Department of Computer and Information Science
  25. ;                        University of Massachusetts
  26. ;                        Amherst, Massachusetts 01003
  27. ;
  28. ; This software was conceived, designed, and written by Dan Suthers 
  29. ; while supported by the National Science Foundation under grant number
  30. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  31. ; CA.  Partial support was also received from the Office of Naval Research
  32. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  33. ; I wish to acknowledge the generous support of Beverly Woolf, who obtained 
  34. ; the above grants and encouraged me to pursue my own research interests in
  35. ; her lab.  This work would not have been possible without the resources and
  36. ; stimulating environment of the Computer and Information Science department.
  37. ;
  38. ; Permission to use, modify, and distribute this software is granted subject 
  39. ; to the following restrictions and understandings:
  40. ; 1. The file header, including this notice, shall be retained, and may be
  41. ;    extended to include documentation of modifications to the software.
  42. ; 2. This material is for nonprofit educational and research purposes only.
  43. ;    Users are requested, but not required, to inform Mr. Suthers of any 
  44. ;    noteworthy uses of this software.
  45. ; 3. Mr. Suthers and the University of Massachusetts make no warrantee or
  46. ;    representation that the operation of this software will be error free,
  47. ;    and are under no obligation to provide any services.
  48. ; 4. Any user of such software agrees to indemnify and hold harmless Mr.
  49. ;    Suthers and the University of Massachusetts from all claims arising 
  50. ;    out of the use or misuse of this software, or arising out of any 
  51. ;    accident, injury, or damage whatsoever, and from all costs, counsel
  52. ;    fees, and liabilities incurred in or about any such claim, action, or
  53. ;    proceeding brought thereon.
  54. ; 5. All materials and reports developed as a consequence of the use of 
  55. ;    this software shall duly acknowledge such use, in accordance with
  56. ;    the usual standards of acknowledging credit in academic research.
  57. ;
  58. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59.  
  60. (in-package :UTILS)
  61.  
  62. (export '(
  63.           dequeue-contents
  64.           init-dequeue
  65.           pop-dequeue
  66.           push-dequeue
  67.           queue-dequeue
  68.           sort-dequeue
  69.           top-dequeue
  70.           ))
  71.  
  72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73.  
  74. (defmacro INIT-DEQUEUE (place &optional (contents nil))
  75.   "init-dequeue <place> &optional <contents>
  76.   Setf's <place> to a fresh dequeue which is empty or contains the optionally
  77.   provided <contents>.  Returns the contents."
  78.   `(let ((the-contents ,contents))
  79.      (setf ,place (cons the-contents (last the-contents)))
  80.      (car ,place)))
  81.  
  82. (defmacro DEQUEUE-CONTENTS (dequeue)
  83.   "dequeue-contents <dequeue> - returns actual (uncopied) list of contents."
  84.   `(car ,dequeue))
  85.  
  86. (defmacro TOP-DEQUEUE (dequeue)
  87.   "top-dequeue <dequeue> - returns the first item on <dequeue>, if any,
  88.   without removing it. NIL is returned if there is nothing in the dequeue."
  89.   `(car (car ,dequeue)))
  90.  
  91. (defmacro PUSH-DEQUEUE (item dequeue)
  92.   "push-dequeue <item> <dequeue> - pushes <item> on the dequeue, returning 
  93.   the dequeue's new contents."
  94.   `(progn (setf (car ,dequeue) (cons ,item (car ,dequeue)))
  95.           ;; Make previously empty dequeue point to single entry from both ends.
  96.           (if (null (cdr ,dequeue)) (setf (cdr ,dequeue) (car ,dequeue)))
  97.           ;; Return contents.
  98.           (car ,dequeue)))
  99.  
  100. (defmacro POP-DEQUEUE (dequeue)
  101.   "pop-dequeue <dequeue> - removes and returns the first item on <dequeue>, 
  102.   if any, returning NIL otherwise."
  103.   `(prog1 (car (car ,dequeue))
  104.      (setf (car ,dequeue) (cdr (car ,dequeue)))
  105.      (if (null (car ,dequeue)) (setf (cdr ,dequeue) nil))))
  106.  
  107. (defmacro QUEUE-DEQUEUE (item dequeue)
  108.   "queue-dequeue <item> <dequeue> - queues <item> on the end of <dequeue>,
  109.   returning the new list of contents."
  110.   `(if (dequeue-contents ,dequeue)
  111.      (let ((new-entry (cons ,item nil)))
  112.        (declare (cons new-entry))
  113.        ;; Set the pointer out of the last cell to the new cell.
  114.        (setf (cdr (cdr ,dequeue)) new-entry)
  115.        ;; Set the last-cell pointer of the dequeue to the new cell.
  116.        (setf (cdr ,dequeue) new-entry)
  117.        ;; Return contents.
  118.        (car ,dequeue))
  119.      ;; empty queue: push is equivalent.
  120.      (push-dequeue ,item ,dequeue)))
  121.  
  122. (defmacro SORT-DEQUEUE (dequeue predicate)
  123.   "sort-dequeue <dequeue> <predicate> - sorts contents according to <predicate>."
  124.   `(init-dequeue ,dequeue
  125.                  (sort (dequeue-contents ,dequeue) ,predicate)))
  126.  
  127. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  128. (provide :dequeue)
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130. ;;; The End.